home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d13 / pcrsep89.arc / SEEP.BAS < prev    next >
BASIC Source File  |  1990-03-21  |  1KB  |  50 lines
  1. ' A Quick Basic program which simulates water seeping through rocks and soil
  2. ' Save as:     SEEP.BAS
  3. ' Compile:     BC SEEP;
  4. '              LINK SEEP CA;
  5.  
  6. DEFINT A-Z
  7. ' $INCLUDE: 'CA.BI'
  8.  
  9. COMMON SHARED CellRow, p!
  10. CONST Dry = 0
  11. CONST Wet = 1
  12.  
  13. CLS
  14. DO
  15.     INPUT "Enter probability (0 to 1) ==> ", p!
  16. LOOP WHILE p! <= 0 OR p! >= 1
  17.  
  18. x% = CAINIT(5, VARPTR(CaArray(0)))        'Use 200 x 320 CGA graphics
  19. RANDOMIZE TIMER
  20.  
  21. FOR i = 1 TO 320
  22.     CALL CASET(1, i, Wet)                    'Set whole top row wet
  23. NEXT i
  24. CASHOW                                            'Show starting screen
  25. CellRow = 2                                        'Keep track of rows
  26. DO WHILE INKEY$ = ""
  27.     CAGEN
  28.     CellRow = CellRow + 1
  29. LOOP
  30.  
  31. CARESET
  32. END
  33.  
  34. FUNCTION CaCell%                                      'Do the work here
  35.     IF CaArray(SelfRow) <> CellRow THEN        'If this isn't the correct row
  36.         result = CaArray(Self)                    '  then don't change
  37.     ELSE
  38.         result = Dry                                    'Assume we're dry
  39.         FOR i = NorthWest TO NorthEast STEP 2    'Look both ways --
  40.             IF CaArray(i) = Wet THEN                'If either is wet, then
  41.                 IF RND < p! THEN                        '  we have a chance to be wet
  42.                     result = Wet
  43.                 END IF
  44.             END IF
  45.         NEXT i
  46.     END IF
  47.     CaCell% = result
  48. END FUNCTION
  49.  
  50.